home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
prohp5.zip
/
PCX.PRG
< prev
next >
Wrap
Text File
|
1993-02-10
|
5KB
|
153 lines
/*
┌─────────────────────────────────────────────────────────────────────────┐
│ │
│ Program : PCX.PRG │
│ │
│ Purpose : To demonstrate use of ProHP PCX functions. │
│ │
│ Author : Copyright (C) 1992,1993 I.L.A.,Inc. All Rights reserved. │
│ │
│ Comments: This source code may be distributed and used freely │
│ provided that the copyright notice is not removed. │
│ │
└─────────────────────────────────────────────────────────────────────────┘
*/
#include "prohp.ch"
#include "propcx.ch"
proc main(cPcxf,lpt)
Local aPcx[14],cPcxFile:="",cLpt:="LPT1"
Local nImageH,nImageW,nMarg:=0.05
Local bImageH,bImageW,nRes
Local nTop:=0.5,nLeft:=0.5
bImageW:={|r|HPi2cur((aPcx[PCXX2]-aPcx[PCXX1]+1)/r)}
bImageH:={|r|HPi2cur((aPcx[PCXY2]-aPcx[PCXY1]+1)/r)}
if cPcxF==NIL
scroll(,,,,5)
accept "Show data for PCX file : " to cPcxFile
else
cPcxFile:=trim(cPcxF)
endif
cls
HP_init()
aPcx:=pcx_info(cPcxFile,.t.) // read image info into array
scroll(,,,,5)
qout("Sending Image to :",cLpt, ", Please Wait...")
if lpt!=NIL
cLpt:=lpt
endif
set2print(cLpt)
HP_stmacro(1) // start a macro definition
SET2SCREEN()
HP_PRpcx(cPcxFile,.f.,cLpt) // send macro data
SET2PRINT(cLpt,.T.)
HP_endmacro(1,PERMMACRO) // make macro permanent
HP_orient(LANDSCAPE)
HP_rastdir(0) // direction of printing for raster image
HPshadow(.t.) // we like shadow boxes
nRes:=100
HP_setres(nRes) // use 100 DPI
nImageH:=eval(bImageH,nRes)
nImageW:=eval(bImageW,nRes)
HP_setpos(nTop,nLeft) // position cursor
HP_savecsr() // save CAP
HP_rbox(nImageH+(nMarg*2),nImageW+(nMarg*2))
HP_setpos(nMarg,nMarg,.t.) // move nMarg down and nMarg to the right
HP_prmode(TRANSPARENT,OPAQUE,50,GFILLGRAY) // print as 50% gray shade
HP_callmacro(1) // print image
HP_prmode() // back to default
HP_restcsr() // restore CAP
// Now we draw the same image using 300 DPI resolution
HP_setpos(0,nImageW+(nMarg*5),.t.) // move to next pos
HP_savecsr() // save CAP
nRes:=300
HP_setres(nRes)
nImageH:=eval(bImageH,nRes)
nImageW:=eval(bImageW,nRes)
HP_rbox(nImageH+(nMarg*2),nImageW+(nMarg*2))
HP_setpos(nMarg,nMarg,.t.) // move nMarg down and nMarg to the right
HP_callmacro(1) // print image
HP_restcsr() // restore CAP
// set new H and W for image
HP_setpos(nImageH+(nMarg*5),0,.t.) // move to next pos
HP_savecsr() // save CAP
nRes:=300
HP_setres(nRes)
nImageH:=eval(bImageH,nRes)* 0.75 // reduce Height to 75%
nImageW:=eval(bImageW,nRes)* 0.6 // reduce Width to 60%
HP_rastW(nImageW*nRes) // set Width of raster
HP_rastH(nImageH*nRes) // set Height of raster
HP_rbox(nImageH+(nMarg*2),nImageW+(nMarg*2))
HP_setpos(nMarg,nMarg,.t.) // move nMarg down and nMarg to the right
HP_callmacro(1) // print image
HP_restcsr() // restore CAP
HP_reset()
// PCX image is still kept in printer memory
set2screen()
return
Function pcx_info(cPcxFile,lShow)
Local aPcxDescr,aPcx[PCXDATASIZE]
Local i,nLm:=5,nLm2:=36,nTop:=4,nTtop:=0
Local nImageW:=0,nImageH:=0,sFactor:=1
Local nWIsize,nHIsize,nWCMsize,nHCMsize
aPcxDescr := {;
cPCXMANUF,cPCXVERSION,cPCXRLE,cPCXBITPIXEL,cPCXX1,cPCXY1,cPCXX2,;
cPCXY2,cPCXHRES,cPCXVRES,cPCXPLANES,cPCXBYTELINE,cPCXSCANNERH,cPCXSCANNERV }
lShow:=iif(lShow==NIL,.f.,lShow)
if (pcxinfo(trim(cPcxFile),aPcx) < 0)
qout("Error reading file :",cPcxFile)
wait
return {}
endif
if lShow
cls
@ 0,0 TO maxrow(),maxcol() DOUBLE
@ 0,1 SAY padc("[ PCX image Info. ]",maxcol()-2,"═")
@ 2,nLm say "PCX File : "+cPcxFile
nTtop:=nTop
for i:=1 to len(aPcx)
@ ++nTop,nLm say padr(aPcxDescr[i],18,".")+"="+str(aPcx[i],8)
next
nTop:=nTtop
set decimal to 2
sFactor:=2.54
nImageW:=aPcx[PCXX2]-aPcx[PCXX1]+1
nImageH:=aPcx[PCXY2]-aPcx[PCXY1]+1
nWIsize:=nImageW/300
nHIsize:=nImageH/300
nWCMsize:=nImageW/300*2.54
nHCMsize:=nImageH/300*2.54
@ ++nTop,nLm2 say "Image size :"+str(nImageW,5)+" W "+str(nImageH,5)+" H pixels."
nTop++
@ ++nTop,nLm2 SAY "Res. "+padc("Size Inch",12)+' '+padc("Size CM",12)
@ ++nTop,nLm2 SAY "---- "+PADC("",12,"-")+' '+PADR("",12,"-")
@ ++nTop,nLm2 SAY " 300 "+str(nWIsize,5,2)+" x"+str(nHIsize,5,2)+' '+str(nWCMsize,5,2)+" x"+str(nHCMsize,5,2)
@ ++nTop,nLm2 SAY " 150 "+str(nWIsize*2,5,2)+" x"+str(nHIsize*2,5,2)+' '+str(nWCMsize*2,5,2)+" x"+str(nHCMsize*2,5,2)
@ ++nTop,nLm2 SAY " 100 "+str(nWIsize*3,5,2)+" x"+str(nHIsize*3,5,2)+' '+str(nWCMsize*3,5,2)+" x"+str(nHCMsize*3,5,2)
@ ++nTop,nLm2 SAY " 75 "+str(nWIsize*4,5,2) +" x"+str(nHIsize*4,5,2)+' '+str(nWCMsize*4,5,2) +" x"+str(nHCMsize*4,5,2)
set decimal to
@ maxrow()-2,nLm say "Press Any key to continue..."
inkey(0)
endif
return aPcx